home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / nexttsrc.lha / nexttsources / sources / comp / back_end / m68emit.t < prev    next >
Encoding:
Text File  |  1990-06-19  |  5.1 KB  |  156 lines
  1. (herald m68emit)
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.               
  26. (define (generate-move ref1 ref2)
  27.   (if (neq? ref1 ref2)
  28.       (if (and (pair? ref1) (null? (cdr ref1)))
  29.           (generate-move-address (car ref1) ref2)
  30.           (emit m68/move .l ref1 ref2))))
  31.  
  32. (define-integrable (generate-move-word ref1 ref2)
  33.   (if (neq? ref1 ref2)
  34.       (emit m68/move .w ref1 ref2)))
  35.  
  36. (define-integrable (generate-move-byte ref1 ref2)
  37.   (if (neq? ref1 ref2)
  38.       (emit m68/move .b ref1 ref2)))
  39.  
  40. (define (generate-push access)
  41.   (increment-stack)
  42.   (if (and (pair? access) (null? (cdr access)))
  43.       (emit m68/pea (car access))
  44.       (emit m68/move .l access (@-r 15))))
  45.  
  46. (define-integrable (generate-pop access)
  47.   (emit m68/move .l (@r+ 15) access))
  48.  
  49.  
  50. (define (adjust-stack-pointer n)
  51.   (if (fxn= n 0) (emit m68/lea (d@r 15 n) SP)))
  52.  
  53. (define (generate-move-address from to)
  54.   (cond ((register? to)
  55.          (if (or (atom? from)
  56.                  (neq? (car from) to)
  57.                  (neq? (cdr from) 0))
  58.              (emit m68/lea from to)))
  59.         ((reg-node AN)
  60.          (emit m68/pea from)
  61.          (generate-pop to))
  62.         (else
  63.          (emit m68/lea from AN)
  64.          (emit m68/move .l AN to))))
  65.                
  66. (define-integrable (generate-slink-jump offset)
  67.   (emit m68/jsr (*d@nil offset)))
  68.  
  69.  
  70. (define-integrable (generate-jump-to-subroutine fg)
  71.   (emit m68/jsr fg))
  72.                    
  73. (define-integrable (generate-jump-absolute fg)
  74.   (emit m68/jmp fg))
  75.                    
  76. (define-integrable (generate-jump label)
  77.   (emit-jump 'jmp label nil))
  78.  
  79. (define-integrable (generate-avoid-jump label)
  80.   (emit-avoid-jump 'jmp label nil))
  81.  
  82. (define (generate-return n-args)               
  83.   (emit m68/move .l (machine-num (fx- -1 n-args)) NARGS)
  84.   (emit m68/move .l (@r 15) TP)
  85.   (emit m68/jmp (@r 13)))
  86.  
  87. (define (generate-return-without-nargs)
  88.   (emit m68/move .l (@r 15) TP)
  89.   (emit m68/jmp (@r 13)))
  90.  
  91.  
  92. (define (generate-general-call proc-var n-args)
  93.   (emit m68/move .l  (machine-num (fx+ n-args 1)) NARGS)
  94.   (cond ((and (or (variable-binder proc-var)
  95.           (var-is-vcell? proc-var)))
  96.      (emit m68/jmp (*d@nil slink/icall)))
  97.     (else
  98.          (emit m68/move .l (reg-offset P -2) TP)
  99.          (emit m68/jmp (@r 13)))))
  100.  
  101.     
  102. (define-integrable (generate-push-address access)
  103.   (increment-stack)
  104.   (emit m68/pea access))
  105.  
  106.       
  107. (define-integrable (increment-stack)
  108.   (set *stack-pos* (fx+ *stack-pos* CELL)))
  109.  
  110. (define-integrable (n-decrement-stack n)
  111.   (set *stack-pos* (fx- *stack-pos* (fx* n CELL))))
  112.  
  113. (define (emit op . args)
  114.   (m68emit (apply op (map! ->field-group args))))
  115.  
  116.  
  117. (define (indexer address offset data)
  118.   (cons (cons address data) offset))
  119.  
  120. (define (->field-group operand)
  121.   (cond ((fg? operand) operand)
  122.         ((fixnum? operand)
  123.          (register->field-group operand))
  124.         ((atom? operand) operand)
  125.         ((fg? (car operand)) operand)
  126.         ((fixnum? (car operand))
  127.          (d@r (symbolic->machine-reg (car operand)) (cdr operand)))
  128.         (else
  129.          (index (d@r (symbolic->machine-reg (caar operand)) (cdr operand))
  130.                 (symbolic->machine-reg (cdar operand))))))
  131.  
  132. (define (symbolic->machine-reg reg)
  133.   (cond ((fx< reg 0)
  134.          (vref *reserved-registers* (fx- 0 reg)))
  135.         ((fx>= reg 6) (fx+ reg 2))
  136.         (else reg)))
  137.  
  138. (define (register->field-group reg)
  139.   (cond ((fx< reg 0)
  140.          (r (vref *reserved-registers* (fx- 0 reg))))
  141.         ((fx< reg 6)
  142.          (r reg))   
  143.         ((fx< reg *real-registers*)
  144.          (r (fx+ reg 2)))
  145.         (else
  146.          (d@r 14 (fx* (fx- reg *real-registers*) CELL)))))
  147.  
  148.  
  149. (define *reserved-registers*
  150.   '#(nil 13 7   15 14    6))
  151. ;        TP nil SP TASK SCRATCH
  152.  
  153.  
  154. (define (emit-hacked-branch jump-op displ)
  155.   (%emit m68/hack-jbcc (jump-op->m68-cc jump-op) displ))
  156.